home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / lib / perl5 / 5.8.7 / Math / BigInt / CalcEmu.pm < prev    next >
Text File  |  2006-04-25  |  9KB  |  330 lines
  1. package Math::BigInt::CalcEmu;
  2.  
  3. use 5.005;
  4. use strict;
  5. # use warnings;    # dont use warnings for older Perls
  6. use vars qw/$VERSION/;
  7.  
  8. $VERSION = '0.05';
  9.  
  10. package Math::BigInt;
  11.  
  12. # See SYNOPSIS below.
  13.  
  14. my $CALC_EMU;
  15.  
  16. BEGIN
  17.   {
  18.   $CALC_EMU = Math::BigInt->config()->{'lib'};
  19.   # register us with MBI to get notified of future lib changes
  20.   Math::BigInt::_register_callback( __PACKAGE__, sub { $CALC_EMU = $_[0]; } );
  21.   }
  22.  
  23. sub __emu_band
  24.   {
  25.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  26.  
  27.   return $x->bzero(@r) if $y->is_zero() || $x->is_zero();
  28.   
  29.   my $sign = 0;                    # sign of result
  30.   $sign = 1 if $sx == -1 && $sy == -1;
  31.  
  32.   my ($bx,$by);
  33.  
  34.   if ($sx == -1)                # if x is negative
  35.     {
  36.     # two's complement: inc and flip all "bits" in $bx
  37.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  38.     $bx =~ s/-?0x//;
  39.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  40.     }
  41.   else
  42.     {
  43.     $bx = $x->as_hex();                # get binary representation
  44.     $bx =~ s/-?0x//;
  45.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  46.     }
  47.   if ($sy == -1)                # if y is negative
  48.     {
  49.     # two's complement: inc and flip all "bits" in $by
  50.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  51.     $by =~ s/-?0x//;
  52.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  53.     }
  54.   else
  55.     {
  56.     $by = $y->as_hex();                # get binary representation
  57.     $by =~ s/-?0x//;
  58.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  59.     }
  60.   # now we have bit-strings from X and Y, reverse them for padding
  61.   $bx = reverse $bx;
  62.   $by = reverse $by;
  63.  
  64.   # padd the shorter string
  65.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  66.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  67.   my $diff = CORE::length($bx) - CORE::length($by);
  68.   if ($diff > 0)
  69.     {
  70.     # if $yy eq "\x00", we can cut $bx, otherwise we need to padd $by
  71.     $by .= $yy x $diff;
  72.     }
  73.   elsif ($diff < 0)
  74.     {
  75.     # if $xx eq "\x00", we can cut $by, otherwise we need to padd $bx
  76.     $bx .= $xx x abs($diff);
  77.     }
  78.   
  79.   # and the strings together
  80.   my $r = $bx & $by;
  81.  
  82.   # and reverse the result again
  83.   $bx = reverse $r;
  84.  
  85.   # One of $x or $y was negative, so need to flip bits in the result.
  86.   # In both cases (one or two of them negative, or both positive) we need
  87.   # to get the characters back.
  88.   if ($sign == 1)
  89.     {
  90.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  91.     }
  92.   else
  93.     {
  94.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  95.     }
  96.  
  97.   # leading zeros will be stripped by _from_hex()
  98.   $bx = '0x' . $bx;
  99.   $x->{value} = $CALC_EMU->_from_hex( $bx );
  100.  
  101.   # calculate sign of result
  102.   $x->{sign} = '+';
  103.   $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
  104.  
  105.   $x->bdec() if $sign == 1;
  106.  
  107.   $x->round(@r);
  108.   }
  109.  
  110. sub __emu_bior
  111.   {
  112.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  113.  
  114.   return $x->round(@r) if $y->is_zero();
  115.  
  116.   my $sign = 0;                    # sign of result
  117.   $sign = 1 if ($sx == -1) || ($sy == -1);
  118.  
  119.   my ($bx,$by);
  120.  
  121.   if ($sx == -1)                # if x is negative
  122.     {
  123.     # two's complement: inc and flip all "bits" in $bx
  124.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  125.     $bx =~ s/-?0x//;
  126.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  127.     }
  128.   else
  129.     {
  130.     $bx = $x->as_hex();                # get binary representation
  131.     $bx =~ s/-?0x//;
  132.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  133.     }
  134.   if ($sy == -1)                # if y is negative
  135.     {
  136.     # two's complement: inc and flip all "bits" in $by
  137.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  138.     $by =~ s/-?0x//;
  139.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  140.     }
  141.   else
  142.     {
  143.     $by = $y->as_hex();                # get binary representation
  144.     $by =~ s/-?0x//;
  145.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  146.     }
  147.   # now we have bit-strings from X and Y, reverse them for padding
  148.   $bx = reverse $bx;
  149.   $by = reverse $by;
  150.  
  151.   # padd the shorter string
  152.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  153.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  154.   my $diff = CORE::length($bx) - CORE::length($by);
  155.   if ($diff > 0)
  156.     {
  157.     $by .= $yy x $diff;
  158.     }
  159.   elsif ($diff < 0)
  160.     {
  161.     $bx .= $xx x abs($diff);
  162.     }
  163.  
  164.   # or the strings together
  165.   my $r = $bx | $by;
  166.  
  167.   # and reverse the result again
  168.   $bx = reverse $r;
  169.  
  170.   # one of $x or $y was negative, so need to flip bits in the result
  171.   # in both cases (one or two of them negative, or both positive) we need
  172.   # to get the characters back.
  173.   if ($sign == 1)
  174.     {
  175.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  176.     }
  177.   else
  178.     {
  179.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  180.     }
  181.  
  182.   # leading zeros will be stripped by _from_hex()
  183.   $bx = '0x' . $bx;
  184.   $x->{value} = $CALC_EMU->_from_hex( $bx );
  185.  
  186.   # calculate sign of result
  187.   $x->{sign} = '+';
  188.   $x->{sign} = '-' if $sign == 1 && !$x->is_zero();
  189.  
  190.   # if one of X or Y was negative, we need to decrement result
  191.   $x->bdec() if $sign == 1;
  192.  
  193.   $x->round(@r);
  194.   }
  195.  
  196. sub __emu_bxor
  197.   {
  198.   my ($self,$x,$y,$sx,$sy,@r) = @_;
  199.  
  200.   return $x->round(@r) if $y->is_zero();
  201.  
  202.   my $sign = 0;                    # sign of result
  203.   $sign = 1 if $x->{sign} ne $y->{sign};
  204.  
  205.   my ($bx,$by);
  206.  
  207.   if ($sx == -1)                # if x is negative
  208.     {
  209.     # two's complement: inc and flip all "bits" in $bx
  210.     $bx = $x->binc()->as_hex();            # -1 => 0, -2 => 1, -3 => 2 etc
  211.     $bx =~ s/-?0x//;
  212.     $bx =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  213.     }
  214.   else
  215.     {
  216.     $bx = $x->as_hex();                # get binary representation
  217.     $bx =~ s/-?0x//;
  218.     $bx =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  219.     }
  220.   if ($sy == -1)                # if y is negative
  221.     {
  222.     # two's complement: inc and flip all "bits" in $by
  223.     $by = $y->copy()->binc()->as_hex();        # -1 => 0, -2 => 1, -3 => 2 etc
  224.     $by =~ s/-?0x//;
  225.     $by =~ tr/0123456789abcdef/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  226.     }
  227.   else
  228.     {
  229.     $by = $y->as_hex();                # get binary representation
  230.     $by =~ s/-?0x//;
  231.     $by =~ tr/fedcba9876543210/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/;
  232.     }
  233.   # now we have bit-strings from X and Y, reverse them for padding
  234.   $bx = reverse $bx;
  235.   $by = reverse $by;
  236.  
  237.   # padd the shorter string
  238.   my $xx = "\x00"; $xx = "\x0f" if $sx == -1;
  239.   my $yy = "\x00"; $yy = "\x0f" if $sy == -1;
  240.   my $diff = CORE::length($bx) - CORE::length($by);
  241.   if ($diff > 0)
  242.     {
  243.     $by .= $yy x $diff;
  244.     }
  245.   elsif ($diff < 0)
  246.     {
  247.     $bx .= $xx x abs($diff);
  248.     }
  249.  
  250.   # xor the strings together
  251.   my $r = $bx ^ $by;
  252.  
  253.   # and reverse the result again
  254.   $bx = reverse $r;
  255.  
  256.   # one of $x or $y was negative, so need to flip bits in the result
  257.   # in both cases (one or two of them negative, or both positive) we need
  258.   # to get the characters back.
  259.   if ($sign == 1)
  260.     {
  261.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/0123456789abcdef/;
  262.     }
  263.   else
  264.     {
  265.     $bx =~ tr/\x0f\x0e\x0d\x0c\x0b\x0a\x09\x08\x07\x06\x05\x04\x03\x02\x01\x00/fedcba9876543210/;
  266.     }
  267.  
  268.   # leading zeros will be stripped by _from_hex()
  269.   $bx = '0x' . $bx;
  270.   $x->{value} = $CALC_EMU->_from_hex( $bx );
  271.  
  272.   # calculate sign of result
  273.   $x->{sign} = '+';
  274.   $x->{sign} = '-' if $sx != $sy && !$x->is_zero();
  275.  
  276.   $x->bdec() if $sign == 1;
  277.  
  278.   $x->round(@r);
  279.   }
  280.  
  281. ##############################################################################
  282. ##############################################################################
  283.  
  284. 1;
  285. __END__
  286.  
  287. =head1 NAME
  288.  
  289. Math::BigInt::CalcEmu - Emulate low-level math with BigInt code
  290.  
  291. =head1 SYNOPSIS
  292.  
  293.     use Math::BigInt::CalcEmu;
  294.  
  295. =head1 DESCRIPTION
  296.  
  297. Contains routines that emulate low-level math functions in BigInt, e.g.
  298. optional routines the low-level math package does not provide on it's own.
  299.  
  300. Will be loaded on demand and called automatically by BigInt.
  301.  
  302. Stuff here is really low-priority to optimize, since it is far better to
  303. implement the operation in the low-level math libary directly, possible even
  304. using a call to the native lib.
  305.  
  306. =head1 METHODS
  307.  
  308. =head2 __emu_bxor
  309.  
  310. =head2 __emu_band
  311.  
  312. =head2 __emu_bior
  313.  
  314. =head1 LICENSE
  315.  
  316. This program is free software; you may redistribute it and/or modify it under
  317. the same terms as Perl itself. 
  318.  
  319. =head1 AUTHORS
  320.  
  321. (c) Tels http://bloodgate.com 2003, 2004 - based on BigInt code by
  322. Tels from 2001-2003.
  323.  
  324. =head1 SEE ALSO
  325.  
  326. L<Math::BigInt>, L<Math::BigFloat>, L<Math::BigInt::BitVect>,
  327. L<Math::BigInt::GMP> and L<Math::BigInt::Pari>.
  328.  
  329. =cut
  330.